home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio / Ham Radio CD-ROM (Emerald Software) (1995).ISO / misc / fd2 / fd2.bas
Encoding:
BASIC Source File  |  1985-06-27  |  7.6 KB  |  354 lines
  1. 10 '    'FD2.BAS' ARRL PX #18  K8HF 05/27/83
  2. 20 '
  3. 30 '    FIELD DAY PROGRAM
  4. 40 '    by G. M. PALMER K8LG
  5. 50 '
  6. 60 ' Corrected by Harry Frietchen K8HF
  7. 62 '     Corrected Edit file problem &
  8. 64 '     added Header.
  9. 66 '
  10. 68 ' File Name conventions for Header:
  11. 70 '     "FDxxyyzz"
  12. 71 '         where xx = Year
  13. 72 '               yy = CW for CW
  14. 73 '                  = PH for SSB or FM
  15. 74 '                  = NV for Novice
  16. 75 '               zz = Band (in Meters)
  17. 76 '
  18. 77 '      Example "FD85CW80" = 80 meter CW for 1985
  19. 78 '         (When NV is specified, print out will
  20. 79 '                      ask for Novice Call.)
  21. 80 '   CLEAR 5000
  22. 90 DEFINT A-Z
  23. 100 DIM B$(700),RN(700)
  24. 110 PRINT
  25. 120 PRINT"FIELD DAY CROSS CHECK PROGRAM"
  26. 130 PRINT"by G. M. PALMER   K8LG"
  27. 140 PRINT
  28. 150 PRINT"PRINTER WIDTH ";
  29. 160 INPUT W
  30. 170 W1=INT(W/8)
  31. 180 W2=INT(W/13)
  32. 190 '
  33. 200 '    READ COMMAND NAMES
  34. 210 '
  35. 220 FOR K=1 TO 6
  36. 230 READ CMD$(K)
  37. 240 NEXT K
  38. 250 DATA EC,SC,DC,EX,EL,ED
  39. 260 '
  40. 270 '    PRINT COMMAND SUMMARY
  41. 280 '
  42. 290 FILES
  43. 295 PRINT
  44. 300 PRINT"FUNCTION: ";
  45. 310 PRINT TAB(13);"EC....Enter Calls"
  46. 320 PRINT TAB(13);"EL....Entry List"
  47. 330 PRINT TAB(13);"ED....Edit File"
  48. 340 PRINT TAB(13);"SC....Sort Calls"
  49. 350 PRINT TAB(13);"DC....Display Calls"
  50. 360 PRINT TAB(13);"EX....Exit Program"
  51. 370 PRINT:PRINT
  52. 380 '
  53. 390 '    INPUT COMMAND
  54. 400 '
  55. 410 PRINT"FUNCTION: ";
  56. 420 LINE INPUT A$
  57. 430 FOR K=1 TO 6
  58. 440 IF A$=CMD$(K) THEN GOTO 500
  59. 450 NEXT K
  60. 460 GOTO 410
  61. 470 '
  62. 480 '    CHOOSE PROGRAAM SECTION BY "K"
  63. 490 '
  64. 500 ON K GOTO 610,1260,1880,540,2220,2540
  65. 510 '
  66. 520 '    EXIT PROGRAM
  67. 530 '
  68. 540 PRINT:PRINT
  69. 550 PRINT"EXIT PROGRAM FD"
  70. 560 PRINT
  71. 570 STOP
  72. 580 '
  73. 590 '    ENTER CALLS TO DISK FILE
  74. 600 '
  75. 610 PRINT
  76. 620 PRINT
  77. 630 PRINT"ENTER CALLS"
  78. 640 GOSUB 2890
  79. 650 PRINT"NEW OR OLD FILE (N OR O): ";
  80. 660 LINE INPUT A$
  81. 670 IF A$="N" THEN RC=0:GOTO 820
  82. 680 IF A$="O" THEN GOTO 700
  83. 690 GOTO 650
  84. 700 GET #1,1
  85. 710 '
  86. 720 '    IF OLD FILE FINISH THE LAST BLOCK
  87. 730 '
  88. 740 RC=VAL(N1$)
  89. 750 GET #1,RC
  90. 760 CC=VAL(N2$)
  91. 770 IF CC=20 THEN A$="N":GOTO 820
  92. 780 N1=CC+1
  93. 790 CC=CC*6
  94. 800 C2$=LEFT$(C1$,CC)
  95. 810 RC=RC-1
  96. 820 PRINT"INPUT CALLS, TYPE DONE TO STOP"
  97. 830 PRINT
  98. 840 IF A$="O" THEN GOTO 860
  99. 850 C2$="":N1=1
  100. 860 FOR K=N1 TO 20
  101. 870 PRINT": ";
  102. 880 LINE INPUT C$
  103. 890 IF C$="DONE" THEN GOTO 1070
  104. 900 L=LEN(C$)
  105. 910 IF L>6 THEN PRINT "TOO LONG":GOTO 870
  106. 920 L1=6-L
  107. 930 C2$=C2$+SPACE$(L1)+C$
  108. 940 NEXT K
  109. 950 '
  110. 960 '    WRITE FULL BLOCK
  111. 970 '
  112. 980 RC=RC+1
  113. 990 RSET N2$=STR$(20)
  114. 1000 RSET N1$="00"
  115. 1010 RSET C1$=C2$
  116. 1020 PUT #1,RC
  117. 1030 GOTO 850
  118. 1040 '
  119. 1050 '    WRITE LAST BLOCK, MAYBE SHORT BLOCK
  120. 1060 '
  121. 1070 IF K=1 THEN GOTO 1160
  122. 1080 RC=RC+1
  123. 1090 RSET N2$=STR$(K-1)
  124. 1100 RSET N1$="00"
  125. 1110 LSET C1$=C2$
  126. 1120 PUT #1,RC
  127. 1130 '
  128. 1140 '    WRITE THE NUMBER OF BLOCKS IN FILE IN FIRST BLOCK
  129. 1150 '
  130. 1160 GET #1,1
  131. 1170 RSET N1$=STR$(RC)
  132. 1180 PUT #1,1
  133. 1190 CLOSE
  134. 1200 PRINT "FILE  ";F$;"  WRITTEN WITH  ";RC;"  BLOCKS AND  ";
  135. 1210 PRINT(RC-1)*20+K-1;"  CALLS"
  136. 1220 GOTO 290
  137. 1230 '
  138. 1240 '    SORT CALLS BY CALL AREA AND SUFFIX
  139. 1250 '
  140. 1260 PRINT
  141. 1270 PRINT"SORT CALLS"
  142. 1280 PRINT
  143. 1290 GOSUB 2890
  144. 1300 GOSUB 2970
  145. 1310 FOR K=1 TO J
  146. 1320 RN(K)=K
  147. 1330 NEXT K
  148. 1340 N=J
  149. 1350 '
  150. 1360 '    REMOVE THE SPACES FROM THE CALLS
  151. 1370 '
  152. 1380 FOR K=1 TO N
  153. 1390 FOR L=1 TO 6
  154. 1400 IF ASC(MID$(B$(K),L,1))<>32 THEN GOTO 1430
  155. 1410 NEXT L
  156. 1420 PRINT"ERROR":STOP
  157. 1430 E=7-L
  158. 1440 B$(K)=MID$(B$(K),L,E)
  159. 1450 NEXT K
  160. 1460 '
  161. 1470 '    FIRST SORT
  162. 1480 '
  163. 1490 PRINT"START FIRST SORT"
  164. 1500 GOSUB 3150
  165. 1510 '
  166. 1520 '    STRIP OFF THE CALL PREFIX
  167. 1530 '
  168. 1540 FOR K=1 TO N
  169. 1550 FOR L=1 TO LEN(B$(K))
  170. 1560 C=ASC(MID$(B$(K),L,1))
  171. 1570 IF (C>=48 AND C<=57) THEN GOTO 1650
  172. 1580 NEXT L
  173. 1590 '
  174. 1600 '    ERROR WHEN CALL HAS NO CALL AREA
  175. 1610 '
  176. 1620 PRINT"ERROR":PRINT B$(K);"  ";
  177. 1630 INPUT B$(K)
  178. 1640 GOTO 1550
  179. 1650 E=7-L
  180. 1660 B$(K)=MID$(B$(K),L,E)
  181. 1670 NEXT K
  182. 1680 '
  183. 1690 '    SECOND SORT
  184. 1700 '
  185. 1710 PRINT"START SECOND SORT"
  186. 1720 GOSUB 3150
  187. 1730 '
  188. 1740 '    WRITE FILE WITH RECORD NUMBERS IN SORTED ORDER
  189. 1750 '
  190. 1760 F1$=F$+".SEQ"
  191. 1770 OPEN "O",#1,F1$
  192. 1780 PRINT #1,N
  193. 1790 FOR K=1 TO N
  194. 1800 PRINT #1,RN(K)
  195. 1810 NEXT K
  196. 1820 CLOSE
  197. 1830 PRINT"FILE  ";F1$;"  CLOSED"
  198. 1840 GOTO 290
  199. 1850 '
  200. 1860 '    PRINT CALLS ON PRINTER
  201. 1870 '
  202. 1880 PRINT
  203. 1890 PRINT"DISPLAY CALLS"
  204. 1900 PRINT
  205. 1910 GOSUB 2890
  206. 1920 GOSUB 2970
  207. 1930 F1$=F$+".SEQ"
  208. 1940 OPEN "I",#1,F1$
  209. 1950 INPUT #1,N
  210. 1960 IF N<>J THEN PRINT "ERROR":STOP
  211. 1970 FOR K=1 TO N
  212. 1980 INPUT #1,RN(K)
  213. 1990 NEXT K
  214. 2000 CLOSE
  215. 2005 GOSUB 3320
  216. 2010 LPRINT:LPRINT
  217. 2020 LPRINT "FIELD DAY CALLS FOR FILE  ";F$
  218. 2030 LPRINT:LPRINT
  219. 2040 PRINT"TOTAL CALLS IN FILE  ";F$;"  ";N
  220. 2050 SC=0:K1=1
  221. 2060 FOR K=1 TO N
  222. 2070 IF K=1 THEN GOTO 2090
  223. 2080 IF B$(RN(K))=B$(RN(K-1)) THEN GOTO 2120
  224. 2090 LPRINT B$(RN(K));"  ";
  225. 2100 K1=K1+1:SC=SC+1
  226. 2110 IF K1>W1 THEN K1=1:LPRINT
  227. 2120 NEXT K
  228. 2130 LPRINT:LPRINT:LPRINT
  229. 2140 LPRINT "TOTAL SCORED CONTACTS:  ";SC
  230. 2150 LPRINT "DUPS.:  ";N-SC
  231. 2160 LPRINT
  232. 2170 GOTO 290
  233. 2180 '
  234. 2190 '    PRINT THE LIST OF CALLS AS ENTERED
  235. 2200 '    WITH RECORD NUMBERS
  236. 2210 '
  237. 2220 PRINT
  238. 2230 PRINT"ENTRY LIST"
  239. 2240 PRINT
  240. 2250 GOSUB 2890
  241. 2260 GOSUB 2970
  242. 2270 LPRINT:LPRINT
  243. 2280 LPRINT "FIELD DAY CALLS FOR FILE  ";F$
  244. 2290 LPRINT "      CALLS ARE IN ENTRY ORDER"
  245. 2300 LPRINT:LPRINT
  246. 2310 L=INT(J/W2)
  247. 2320 C=J-W2*L
  248. 2330 IF C<>0 THEN L=L+1
  249. 2340 EL=W2
  250. 2350 FOR K=1 TO L
  251. 2360 IF C=0 THEN GOTO 2390
  252. 2370 IF K=L THEN EL=C
  253. 2380 I1=1
  254. 2390 FOR M=1 TO EL
  255. 2400 I=K+(M-1)*L
  256. 2410 IF C=0 THEN GOTO 2430
  257. 2420 IF M>(C+1) THEN I=I-I1:I1=I1+1
  258. 2430 LPRINT USING "   ### ";I,
  259. 2440 LPRINT B$(I);
  260. 2450 NEXT M
  261. 2460 LPRINT
  262. 2470 NEXT K
  263. 2480 LPRINT:LPRINT
  264. 2490 LPRINT "TOTAL CALL IN FILE  ";F$;"  ";J
  265. 2500 GOTO 290
  266. 2510 '
  267. 2520 '    EDIT CALLS IN THE RANDOM FILE
  268. 2530 '
  269. 2540 PRINT
  270. 2550 PRINT"EDIT FILE"
  271. 2560 PRINT
  272. 2570 GOSUB 2890
  273. 2580 GET #1,1
  274. 2590 RC=VAL(N1$)
  275. 2600 PRINT:PRINT
  276. 2610 PRINT"CALL NUMBER ";
  277. 2620 INPUT CC
  278. 2630 K=INT(CC/20-.01)+1
  279. 2640 IF K>RC THEN PRINT"OUT OF RANGE":GOTO 2610
  280. 2650 GET #1,K
  281. 2660 J=CC-(K-1)*20
  282. 2670 C2$=C1$
  283. 2680 J=(J-1)*6+1
  284. 2690 PRINT MID$(C2$,J,6);"  : ";
  285. 2700 LINE INPUT C$
  286. 2710 L=LEN(C$)
  287. 2720 IF L>6 THEN PRINT"TOO LONG": GOTO 2690
  288. 2730 L1=6-L
  289. 2740 J1=J-1
  290. 2750 J2=115-J
  291. 2760 C3$=LEFT$(C2$,J1)+SPACE$(L1)+C$+RIGHT$(C2$,J2)
  292. 2770 RSET C1$=C3$
  293. 2780 PUT #1,K
  294. 2790 PRINT"MORE (Y OR N):  ";
  295. 2800 LINE INPUT A$
  296. 2810 IF A$="Y" THEN GOTO 2610
  297. 2820 IF A$="N" THEN GOTO 2840
  298. 2830 GOTO 2790
  299. 2840 CLOSE 
  300. 2850 GOTO 290
  301. 2860 '
  302. 2870 '    SUBROUTINE TO OPEN AND SET UP RANDOM DISK FILE FOR CALLS
  303. 2880 '
  304. 2890 PRINT"DATA FILE NAME: ";
  305. 2900 LINE INPUT F$
  306. 2910 OPEN "R",#1,F$
  307. 2920 FIELD #1, 4 AS N1$, 4 AS N2$, 120 AS C1$
  308. 2930 RETURN
  309. 2940 '
  310. 2950 '    SUBROUTINE TO READ THE CALLS FROM THE RANDOM FILE
  311. 2960 '
  312. 2970 GET #1,1
  313. 2980 RC=VAL(N1$)
  314. 2990 J=1
  315. 3000 FOR K=1 TO RC
  316. 3010 GET #1,K
  317. 3020 CC=VAL(N2$)*6
  318. 3030 C2$=C1$
  319. 3040 FOR L=1 TO CC STEP 6
  320. 3050 B$(J)=MID$(C2$,L,6)
  321. 3060 J=J+1
  322. 3070 NEXT L
  323. 3080 NEXT K
  324. 3090 CLOSE
  325. 3100 J=J-1
  326. 3110 RETURN
  327. 3120 '
  328. 3130 '    SUBROUTINE TO SORT THE ARRAY B$(K)
  329. 3140 '
  330. 3150 KE=N-1
  331. 3160 SW=0
  332. 3170 FOR K=1 TO KE
  333. 3180 IF B$(K)<=B$(K+1) THEN GOTO 3220
  334. 3190 SWAP B$(K),B$(K+1)
  335. 3200 SWAP RN(K),RN(K+1)
  336. 3210 SW=1
  337. 3220 NEXT K
  338. 3230 IF SW=1 THEN KE=KE-1:GOTO 3160
  339. 3240 RETURN
  340. 3300 '
  341. 3310 '  TITLE FOR W8WE FIELD DAY
  342. 3320 '
  343. 3325 INPUT "CLUB CALL USED AT FIELD DAY";CALUS$
  344. 3330 LPRINT CHR$(12):LPRINT:LPRINT CHR$(14);" '";CALUS$;"' - Field Day 19";MID$(F$,3,2);TAB(31);
  345. 3340 IF MID$(F$,5,2)="NV"THEN 3370
  346. 3350 IF MID$(F$,5,2)="PH"THEN LPRINT MID$(F$,7);" PHONE":ELSE LPRINT TAB(34);MID$(F$,7);" CW"
  347. 3360 LPRINT:RETURN
  348. 3370 LPRINT MID$(F$,7);" Novice"
  349. 3380 INPUT "NOVICE CALL USED";NOV$
  350. 3390 LPRINT :LPRINT CHR$(14);"Novice Call - ";NOV$:LPRINT:LPRINT:RETURN
  351. 3400 END
  352. ovice"
  353. 3380 INPUT "NOVICE CALL USED";NOV$
  354. 3390 LPRINT